﻿Public Class LabelX
  Private _dpiFactor As Single = 1.0F
  Private _showTopLine As Boolean = False
  Private _showScrollArrows As Boolean = True
  Private _top As Integer = 0
  Private _lastTop As Integer = 0
  Private _lastMouseY As Integer = 0
  Private _lastTextHeight As Integer = 0

  Private WithEvents _invalidateTimer As New Timer

  Public Property ShowTopLine() As Boolean
    Get
      Return Me._showTopLine
    End Get
    Set(ByVal value As Boolean)
      Me._showTopLine = value
      Me.InvalidateSmart()
    End Set
  End Property

  Public Property ShowScrollArrows() As Boolean
    Get
      Return Me._showScrollArrows
    End Get
    Set(ByVal value As Boolean)
      Me._showScrollArrows = value
      Me.InvalidateSmart()
    End Set
  End Property

  Public Sub New()
    InitializeComponent()
    Me._dpiFactor = Me.AutoScaleDimensions.Height / 192.0F
    Me._invalidateTimer.Interval = 10
  End Sub

  Public Sub InvalidateSmart()
    Me._invalidateTimer.Enabled = True
  End Sub

  Private Sub InvalidateTimer_Tick() Handles _invalidateTimer.Tick
    Me._invalidateTimer.Enabled = False
    Me.Invalidate()
  End Sub

  Protected Overrides Sub OnPaintBackground(ByVal e As System.Windows.Forms.PaintEventArgs)
  End Sub

  Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
    Static Dim bufWidth As Integer = 0
    Static Dim bufHeight As Integer = 0
    Static Dim buffer As Bitmap = Nothing
    Static Dim bufRect As Rectangle = Rectangle.Empty
    Static Dim textRect As Rectangle = Rectangle.Empty
    Static Dim brBg As New SolidBrush(Me.BackColor)
    Static Dim brFg As New SolidBrush(Me.ForeColor)
    Static Dim pnFg As New Pen(Me.ForeColor)
    Static Dim strFormat As New StringFormat
    Static Dim lastShowTopLine As Boolean = False
    Static Dim stringRect As Rectangle = Rectangle.Empty
    Static Dim upArrow(2) As Point
    Static Dim downArrow(2) As Point

    If Me.Height > 0 Then
      If Me.Width <> bufWidth OrElse Me.Height <> bufHeight OrElse lastShowTopLine <> Me._showTopLine Then
        ' Setup back buffer and state variables
        bufWidth = Me.Width
        bufHeight = Me.Height
        lastShowTopLine = Me._showTopLine

        ' Dispose of the old buffer we don't need anymore.
        If buffer IsNot Nothing Then
          buffer.Dispose()
        End If

        ' Buffer
        buffer = New Bitmap(bufWidth, bufHeight)
        bufRect = New Rectangle(0, 0, bufWidth, bufHeight)

        ' String format
        strFormat.FormatFlags = 0
        strFormat.Alignment = StringAlignment.Near
        strFormat.LineAlignment = StringAlignment.Near

        ' Create the arrow triangle point sets
        upArrow(0).X = bufWidth - (Me._dpiFactor * 24)
        upArrow(0).Y = Me._dpiFactor * 12
        upArrow(1).X = bufWidth
        upArrow(1).Y = Me._dpiFactor * 12
        upArrow(2).X = bufWidth - (Me._dpiFactor * 12)
        upArrow(2).Y = 0
        downArrow(0).X = bufWidth - (Me._dpiFactor * 24)
        downArrow(0).Y = bufHeight - (Me._dpiFactor * 12)
        downArrow(1).X = bufWidth
        downArrow(1).Y = bufHeight - (Me._dpiFactor * 12)
        downArrow(2).X = bufWidth - (Me._dpiFactor * 12)
        downArrow(2).Y = bufHeight
      End If

      ' String's rectangle
      If Me._showTopLine Then
        textRect = New Rectangle(4 * Me._dpiFactor, Me._top + 2, bufWidth - (8 * Me._dpiFactor), (0 - Me._top) + (bufHeight - 2))
      Else
        textRect = New Rectangle(4 * Me._dpiFactor, Me._top, bufWidth - (8 * Me._dpiFactor), (0 - Me._top) + bufHeight)
      End If

      ' Create temporary graphics buffer
      Dim g As Graphics = Graphics.FromImage(buffer)

      ' Erase background
      g.FillRectangle(brBg, 0, 0, bufWidth, bufHeight)

      ' Draw top line
      If Me._showTopLine Then
        g.DrawLine(pnFg, 0, 0, bufWidth, 0)
      End If

      ' Draw string
      g.DrawString(Me.Text, Me.Font, brFg, textRect, strFormat)

      ' Draw the arrows
      If Me._showScrollArrows Then
        ' Measure the string we drew
        With ExtendedGraphicsMethods.MeasureString(g, Me.Text, textRect, Me.Font)
          If Me._top < 0 Then
            g.FillPolygon(brFg, upArrow)
          End If
          If Me._top > 0 - (.Height - Me.Height) Then
            g.FillPolygon(brFg, downArrow)
          End If
          Me._lastTextHeight = .Height
        End With
      End If

      ' Copy back to the front buffer
      g.Dispose()
      e.Graphics.DrawImage(buffer, 0, 0)
    End If
  End Sub

  Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
    Me._lastTop = Me._top
    Me._lastMouseY = e.Y
    Me.InvalidateSmart()
  End Sub

  Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
    Me.SetScrollPosition(e.Y)
  End Sub

  Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
    Me.SetScrollPosition(e.Y)
  End Sub

  Private Sub SetScrollPosition(ByVal y As Integer)
    Me._top = Me._lastTop - (Me._lastMouseY - y)

    If Me._top > 0 Then
      Me._top = 0
    ElseIf Me._top < 0 - (Me._lastTextHeight - Me.Height) Then
      Me._top = 0 - (Me._lastTextHeight - Me.Height)
    End If

    Me.InvalidateSmart()
  End Sub
End Class
